C/C++ Users Group Library 1996 July/C-C++ Users Group Library July 1996.iso/vol_400/427_01/software/multijoy.pas

Pascal/Delphi Source File | 1994-03-23 | 11.7 KB | 385 lines

unit multijoy; (* reads out status of the MULTI JOYSTICK INTERFACE *)


(* MULTIJOY uses four DOS environment variables:

   MULTIPATH  is the path where the config file is located
   MULTICFG   is the name of the config file without extension
   MULTIPORT  is optional and states the printer port to be used
              (port 1 is the default if MULTIPORT is empty)
   MULTIDELAY is optional, too. It's the number of NOPs executed to wait
              for the joystick interface between writing and reading the
              printer port status (MULTIDELAY is only necessary if you have
                a) a VERY fast computer or
                b) a VERY slow interface (i.e. a CMOS type) *)


interface


const maxplayer = 6;             (* maximum number of players *)

type TJoy = record
              x, y         : shortint; (* -1 .. +1 (minus is left/up) *)
              lhit,  rhit,             (* directions triggered?       *)
              uhit,  dhit,             (* directions triggered?       *)
              khit,  xhit,             (* buttons triggered?          *)
              knopf, xtra  : boolean;  (* buttons held down?          *)
            end;

     TJoyState  = array [1 .. maxplayer] of TJoy;

     TJoyNum    = array [1 .. maxplayer] of byte;

var  JoyState   : TJoyState;
     (* contains all joystick status information *)
     (* is updated by calling GetAllJoyState     *)

     RealJoyNum,
     JoyNum     : TJoyNum;
     (* JoyNum [Player] contains physical joystick number of logical player *)

     MultiJoyInstalled : boolean;
     (* read-only, TRUE if MULTIJOY is active, FALSE otherwise      *)
     (* if installation is unsuccessful, MULTIJOY usually HALTs     *)
     (* exception: no DOS environment variables stated at all       *)
     (* If your program depends on MULTIJOY, it should HALT with an *)
     (* appropriate error message if MULTIJOYINSTALLED is FALSE.    *)


procedure InitMultiJoy;
(* MULTIJOY initializes itself, but you can initialize again if you want *)

procedure GetAllJoyState;
(* gets status of all joystick ports *)

function  ChangeJoyNum : boolean;
(* changes joystick assignment defined by JoyNum                           *)
(* TRUE if no joystick is used more than once and 1 <= JoyNum <= MAXPLAYER *)

procedure ResetJoyNum;
(* resets joystick assignment and JoyNum array to initial status *)

procedure EmulationOn;
(* enables emulation (if config file contains keyword 'KEYBOARD') *)

procedure EmulationOff;
(* disables emulation (if enabled) *)


implementation


uses crt, dos, multierr, multikbd;

type TDecode  = record
                  stikno1 : byte;
                  action1 : char;
                  stikno2 : byte;
                  action2 : char;
                end;

const zero_action : TJoy
                  = (x     : 0    ; y    : 0;
                     lhit  : false; rhit : false;
                     uhit  : false; dhit : false;
                     khit  : false; xhit : false;
                     knopf : false; xtra : false);
      actionchars = (['L', 'R', 'U', 'D', 'F', '*']);

var multipath    : string;
    multicfg     : string [8];
    multiport    : string [1];
    multidelay   : string [5];
    delaycount   : word;
    printer_port : byte;
    pout,
    p_in         : word;
    decode       : array [0 .. 15] of TDecode;
    key_number   : array [1 .. 2, 0 .. 4] of byte;
    PlayerNum    : TJoyNum;                    (* Inversion of JoyNum *)
    keyboard,
    invert,
    disabled     : boolean;


function read_port (mjoyaddress : byte) : byte;
(* sets MULTI JOYSTICK INTERFACE to address MJOYADDRESS *)
(* reads printer port, i.e. PAPER EMPTY and BUSY bits   *)
begin
  port [pout] := mjoyaddress;
  asm
    mov  cx, delaycount
  @l:
    nop
    loop @l
  end;
  if invert then read_port := not port [p_in]
            else read_port :=     port [p_in];
end;


procedure error_msg (msg_nr, code : integer);
(* calls MULTIERR error message procedure *)
begin
  multierr.error_msg (msg_nr, code, multipath, multicfg, multiport);
end;


function ChangeJoyNum : boolean;
(* changes joystick assignment defined by JoyNum                           *)
(* TRUE if no joystick is used more than once and 1 <= JoyNum <= MAXPLAYER *)
var i    : integer;
    used : array [1 .. maxplayer] of boolean;
    good : boolean;
begin
  for i := 1 to maxplayer do begin
    joynum [i] := realjoynum [joynum [i]];
    used   [i] := false;
  end;
  realjoynum := joynum;

  changejoynum := true;
  for i := 1 to maxplayer do
    if not used [i] and (joynum [i] >= 1) and (joynum [i] <= maxplayer)
      then PlayerNum [JoyNum [i]] := i
      else changejoynum := false;
end;


procedure ResetJoyNum;
(* resets joystick assignment and JoyNum array to initial status *)
var i : integer;
begin
  for i := 1 to maxplayer do joynum [i] := i;
  realjoynum := joynum;
  changejoynum;
end;


procedure InitMultiJoy;
(* reads interface pin assignment from disk *)
(* resets joystick status variables         *)
var cmdline   : string [8];
    cfg       : text;
    i,
    j,
    k,
    error     : integer;
    dummy     : char;


  function get_port_no (port_no : char) : byte;
  (* find printer port number in a string *)
  begin
    if not (port_no in ['1' .. '3']) then error_msg (8, ord (port_no));
    get_port_no := ord(port_no)-ord('0');
  end;


begin
  multipath := getenv ('multipath'); (* read environment variables *)
  multicfg  := getenv ('multicfg' );
  multiport := getenv ('multiport');
  multidelay:= getenv ('multidelay');
  if multidelay<>'' then begin
    val(multidelay,delaycount,error);
    if error<>0 then error_msg (13,0);
    inc(delaycount);
  end else
    delaycount:=1;

  if (multipath + multicfg + multiport) = '' then disabled := true
                                             else disabled := false;

  if not disabled then begin
    if multiport = ''  then printer_port := 1 (* default!   *)
                       else printer_port := get_port_no (multiport [1]);

    pout := memw [$40:$8 + (printer_port-1) * 2];
    if pout = 0 then error_msg (11, printer_port);
    p_in := pout + 1;

    if multipath           = ''  then error_msg (5, 0); (* undefined? *)
    if multicfg            = ''  then error_msg (6, 0); (* undefined? *)
    if pos ('.', multicfg) >  0  then error_msg (7, 0); (* extension? *)

    if multipath[length(multipath)]='\' then
      assign (cfg, multipath + multicfg + '.cfg')
    else
      assign (cfg, multipath + '\' + multicfg + '.cfg');

    {$I-}
    reset(cfg);
    {$I+}
    error := ioresult;
    if error <> 0 then error_msg (1, error);

    readln (cfg, cmdline);
    if (cmdline = 'keyboard') or (cmdline = 'KEYBOARD') then keyboard := true
                                                        else keyboard := false;

    if not keyboard then begin
      reset (cfg);
      for i := 0 to 15 do begin
        with decode [i] do begin
          if eof (cfg) then error_msg (3, 0);
          {$I-}
          readln (cfg, j, stikno1, dummy, action1, stikno2, dummy, action2);
          {$I+}
          error := ioresult;
          if error <> 0 then error_msg (4, error);
          if (stikno1 < 1) or (stikno1 > maxplayer) then error_msg (12, stikno1);
          action1 := upcase (action1);
          if not (action1 in actionchars) then error_msg (2, ord (action1));
          if (stikno2 < 1) or (stikno2 > maxplayer) then error_msg (12, stikno2);
          action2 := upcase (action2);
          if not (action2 in actionchars) then error_msg (2, ord (action2));
        end;
      end;
      if not eof (cfg) then readln (cfg, cmdline)
                       else cmdline := '';
      if (cmdline = 'invert') or (cmdline = 'INVERT') then invert := true
                                                      else invert := false;
      close (cfg);
    end else begin
      for i := 1 to 2 do
        for j := 0 to 4 do begin
          if eof (cfg) then error_msg (3, 0);
          {$I-}
          readln (cfg, dummy, dummy, k);
          {$I+}
          error := ioresult;
          if error <> 0 then error_msg (4, error);
          key_number [i, j] := k;
        end;
      init_kbd;
    end;
    multijoyinstalled := true;
  end else
    multijoyinstalled := false;

  (* initialize joystick status variables *)
  for i:=1 to maxplayer do begin
    RealJoyNum [i] := i;
    JoyNum     [i] := i;
    JoyState   [i] := zero_action;
  end;
  ChangeJoyNum;
end;


procedure EmulationOn;
(* enables emulation (if config file contains keyword 'KEYBOARD') *)
begin
  if keyboard then init_kbd;
end;


procedure EmulationOff;
(* disables emulation (if enabled) *)
begin
  if keyboard then reset_kbd;
end;


procedure GetAllJoyState;
(* gets status of all joysticks *)
var address,
    joy,
    plr_now,
    player,
    pebu     : byte; (* PAPER EMPTY and BUSY bits *)
    old      : array [1 .. maxplayer] of record
                                           ox,
                                           oy : shortint;
                                           ok,
                                           oe : boolean;
                                          end;


  procedure GetKeyState (joy : integer);
  (* gets status of joystick emulating keys *)
  begin
    with joystate [playernum [joy]] do
      with old [playernum [joy]] do begin
        if key [key_number [joy, 0]]
          then begin
            x    := - 1;
            lhit := - 1 <> ox;
          end else
            if key [key_number [joy, 1]] then begin
              x    := 1;
              rhit := 1 <> ox;
            end;
        if key [key_number [joy, 2]] then begin
            y    := - 1;
            uhit := - 1 <> oy;
          end else
            if key [key_number [joy, 3]] then begin
              y    := 1;
              dhit := 1 <> oy;
            end;
        if key [key_number [joy, 4]] then begin
          knopf := true;
          khit  := not ok;
        end;
      end;
  end;


  procedure decode_joystate (decode_action : char);
  (* decodes joystick status *)
  (* note: if you manage to invoke two opposite directions at the same *)
  (* time, the hit-indicators will be misleading                       *)
  begin
    with joystate [plr_now] do
      with old [plr_now] do begin
        case decode_action of
          'L' : begin x := - 1; lhit := - 1 <> ox;   end;
          'R' : begin x :=   1; rhit :=   1 <> ox;   end;
          'U' : begin y := - 1; uhit := - 1 <> oy;   end;
          'D' : begin y :=   1; dhit :=   1 <> oy;   end;
          'F' : begin knopf := true; khit := not ok; end;
          '*' : begin xtra  := true; xhit := not oe; end;
        end;
    end;
  end;


(* GetAllJoyState *)
var i : integer;
begin
  for joy := 1 to maxplayer do begin
    with JoyState [playernum [joy]] do
      with old [playernum [joy]] do begin
        ox := x;
        oy := y;
        ok := knopf;
        oe := xtra;
      end;
    JoyState [playernum [joy]] := zero_action;
  end;

  if not disabled then begin
    if not keyboard then
      for address := 0 to 15 do begin
        pebu := read_port (address);
        (* first bit *)
        plr_now := playernum [decode [address].stikno1];
        if (pebu and $20) <> 0 then decode_joystate (decode [address].action1);
        (* second bit *)
        plr_now := playernum [decode [address].stikno2];
        if (pebu and $80) =  0 then decode_joystate (decode [address].action2);
      end else begin
        GetKeyState (1);
        GetKeyState (2);
      end;
  end;
end;


(* MultiJoy *)
begin
  InitMultiJoy;
end.